00010	BEGIN "PITCH"
00020	DEFINE ⊂="COMMENT"; ⊂ AUG.2,1973;
00030	INTEGER I,J,K,L,M,N,P,Q,R,POINTX,POINTY,STATE,DELTA,VAL,CHAN1,EOF;
00040	INTEGER II,JJ,P1,P2,P3,T1,T2,T3,T4,T,DT,H,TAU1,TAU2;
00050	INTEGER ARRAY BUF,PITCH[0:1000];
00060	STRING FILEN,READ,READ1,FILEO,READ2;
00070	DEFINE CR="'15",LF="'12",TB="'11",CRLF="CR&LF";
00080	
00090	⊂ Three peaks are located, then tests are made on the middle
00100	   one to determine whether it should be reported or discarded;
00110	⊂ These peaks are P1, P2, and P3 with corresponding times of T1, T2 and T3;
00120	
00130	⊂ The conditions for discarding are
00140	    a) just getting started, P1=0
00150	   b) the middle peak is definitely smaller than one at the ends
00160	   c) the time interval between P1 and P2 is too small;
00170	
00180	FILEN←"FLTD.001[DAT,NJM]";
00190	OUTSTR("Type file name (CR for "&FILEN&".");
00200	IF (READ←INCHWL)≠"" THEN FILEN←READ ELSE READ←FILEN;
00210	  READ1←""; FOR I←0 STEP 1 UNTIL 6 DO BEGIN
00220	  READ2←READ[1 TO 1]; READ1←READ1&READ2; READ←READ[2 TO 6];
00230	  IF READ2="." THEN DONE; END;
00240	  FILEO←READ1&"PCH";
00250	  POINTY←POINT(12,PITCH[0],-1);
00260	TAU1←30;
00270	OUTSTR("Set TAU1 (CR for 30) ");IF (READ←INCHWL)≠"" THEN TAU1←CVD(READ);
00280	TAU2←140;
00290	OUTSTR("Set TAU2 (CR for 140) ");IF (READ←INCHWL)≠"" THEN TAU2←CVD(READ);
00300	DELTA←1200;
00310	OUTSTR("Type value for DELTA (CR for 1200) ");
00320	IF (READ←INCHWL)≠"" THEN DELTA←CVD(READ);
00330	CHAN1←1; CLOSE(CHAN1); OPEN(CHAN1,"DSK",'10,10,0,0,0,EOF);
00340	LOOKUP(CHAN1,FILEN,0);
00350	J←K←L←STATE←VAL←R←0;
00360	OUTSTR(CRLF&"Pitch  measure on file "&FILEN &CRLF&LF);
00370	SETFORMAT(4,0); P←P1←P2←P3←T1←T2←T3←H←Q←0;
00380	WHILE EOF=0 DO BEGIN
00390	  FOR J←0 STEP 1 UNTIL 1000 DO BUF[J]←0;
00400	  ARRYIN(CHAN1,BUF[0],1000);
00410	  POINTX←POINT(12,BUF[0],-1);
00420	FOR I←0 STEP 1 UNTIL 2999 DO BEGIN
00430	    L←K*1500+I%2;
00440	    VAL←ILDB(POINTX); IF VAL>2047 THEN VAL←VAL-4096;
00450	
00460	IF H>0 THEN IF VAL≤0 THEN T←L;
00470	
00480	IF VAL>0 THEN IF H≤0 THEN BEGIN
00500	  WHILE TRUE DO BEGIN
00510	
00520	    IF P<P3 THEN DONE;
00540	    T3←(T+T4)%2;
00550	
00560	    IF P1<DELTA THEN BEGIN
00570	      P1←P2; T1←T2; P2←P; T2←T3; DONE END;
00580	
00590	    IF T2-T1>TAU2 THEN BEGIN
00600	       P1←P2; T1←T2; P2←P; T2←T3; DONE END;
00610	
00620	    IF P2<DELTA THEN BEGIN
00630	      P2←P; T2←T3; DONE END;
00640	
00650	    IF T2-T1<TAU1 THEN BEGIN
00660	      IF P2>P1 THEN BEGIN
00670	        P1←P2; T1←T2; P2←P; T2←T3; DONE END ELSE BEGIN
00680	        P2←P; T2←T3; DONE END; END;
00690	
00700	    IF P2<P1 THEN IF P2<P THEN IF T3-T1<TAU2 THEN BEGIN
00710	      P2←P; T2←T3; DONE END;
00720	
00730	    OUTSTR(CVS(T1%10)&CVS(T2-T1)&CVS(P1 LSH -9)&"   ");
00740	    IF (R MOD 4)=3 THEN BEGIN OUTSTR(CRLF); R←0; END ELSE R←R+1;
00750	    TAU1←(TAU1+2*(T2-T1)) LSH -2;
00755	    IF TAU1<30 THEN TAU1←300;
00760	    TAU2←(2*TAU2+3*(T2-T1)) LSH -2;
00765	    IF TAU2>140 THEN TAU2←140;
00770	    Q←Q+1;
00780	    IDPB(T1%10,POINTY); IDPB(T2-T1,POINTY); IDPB((P1 LSH -9),POINTY);
00790	    P1←P2; T1←T2; P2←P; T2←T3; DONE END;
00800	  P3←P; T4←L; P←0; END;
00810	H←VAL;
00820	IF VAL>0 THEN P←P+VAL ELSE P←P-VAL;
00830	
00840	  END;
00850	K←K+1;
00860	
00870	END;
00880	
00890	CLOSE(CHAN1); OPEN(CHAN1,"DSK",'10,0,10,0,0,0);
00900	ENTER(CHAN1,FILEO,0);
00910	ARRYOUT(CHAN1,PITCH[0],Q); RELEASE(CHAN1);
00920	END "PITCH";